Analyzing the DESeq output
Here we run DESeq2 to get our DEGs for our contrasts of choice: We will compare the three different timepoints against each other, generating a total of 3 contrasts. 1. protruding mouth vs day 4 2. day 4 vs day 5 3. protruding mouth vs day 5
dds4v5$stageName <- droplevels(dds4v5$stageName)
dds4vM$stageName <- droplevels(dds4vM$stageName)
dds5vM$stageName <- droplevels(dds5vM$stageName)
dds4v5 = DESeq(dds4v5)
using pre-existing size factors
estimating dispersions
gene-wise dispersion estimates
mean-dispersion relationship
final dispersion estimates
fitting model and testing
dds4vM = DESeq(dds4vM)
using pre-existing size factors
estimating dispersions
gene-wise dispersion estimates
mean-dispersion relationship
final dispersion estimates
fitting model and testing
dds5vM = DESeq(dds5vM)
using pre-existing size factors
estimating dispersions
gene-wise dispersion estimates
mean-dispersion relationship
final dispersion estimates
fitting model and testing
res4v5 <- results(dds4v5, test = "Wald")
res4vM <- results(dds4vM, test = "Wald")
res5vM <- results(dds5vM, test = "Wald")
res5vM = lfcShrink(dds=dds5vM, coef = "stageName_Day.5_vs_Protruding.mouth",res = res5vM, type = "ashr")
using 'ashr' for LFC shrinkage. If used in published research, please cite:
Stephens, M. (2016) False discovery rates: a new deal. Biostatistics, 18:2.
https://doi.org/10.1093/biostatistics/kxw041
res4vM = lfcShrink(dds=dds4vM, coef = "stageName_Day.4_vs_Protruding.mouth",res = res4vM, type = "ashr")
using 'ashr' for LFC shrinkage. If used in published research, please cite:
Stephens, M. (2016) False discovery rates: a new deal. Biostatistics, 18:2.
https://doi.org/10.1093/biostatistics/kxw041
res4v5 = lfcShrink(dds4v5, contrast = c("stageName", "Day.4", "Day.5"),res = res4v5, type="ashr")
using 'ashr' for LFC shrinkage. If used in published research, please cite:
Stephens, M. (2016) False discovery rates: a new deal. Biostatistics, 18:2.
https://doi.org/10.1093/biostatistics/kxw041
Here we us LFCshrink via ashr to shrink our logfold2 changes from the DESeq outputs with respect to our contrasts. We do not use normal type as ashr and apeglm both outperform normal here.
Dispersion Estimates
Here we glance into our data to see if the model is well fit to the data:
plotDispEsts(dds4v5)

plotDispEsts(dds4vM)

plotDispEsts(dds5vM)

Everything looks mostly okay here; it mostly fits the “normal look” here.
Top Genes expressed in Day 5 vs Mouth Protruding
(for (i in order(res5vM$padj, decreasing = F)[1:5]){
plotCounts(dds5vM, gene=i, intgroup="stageName", main = "")
title(rowData(dds5vM)[rownames(res5vM[i,]),]$SYMBOL)
})




NULL

Volcano Plot
fiveMplot = EnhancedVolcano(res5vM,
lab = rowData(dds5vM)$SYMBOL,
x = 'log2FoldChange',
y = 'pvalue')
Warning: One or more p-values is 0. Converting to 10^-1 * current lowest non-zero p-value...
fiveMplot

ggsave("outputs/fivevsMvolcano.pdf", height = 16, width = 8)
Top Genes for expressed Day4 vs mouth Protruding
(for (i in order(res4vM$padj, decreasing = F)[1:5]){
plotCounts(dds4vM, gene=i, intgroup="stageName", main = "")
title(rowData(dds4vM)[rownames(res4vM[i,]),]$SYMBOL)
})




NULL

Volcano Plot
fourMplot = EnhancedVolcano(res4vM,
lab = rowData(dds4vM)$SYMBOL,
x = 'log2FoldChange',
y = 'pvalue')
Warning: One or more p-values is 0. Converting to 10^-1 * current lowest non-zero p-value...
fourMplot

ggsave("outputs/fourvsMvolcano.pdf", height = 16, width = 8)
significant genes 4v5
(for (i in order(res4v5$padj, decreasing = F)[1:5]){
plotCounts(dds4v5, gene=i, intgroup="stageName", main = "")
title(rowData(dds4v5)[rownames(res4v5[i,]),]$SYMBOL)
})




NULL

Volcano plot 4v5
fourfiveplot = EnhancedVolcano(res4v5,
lab = rowData(dds4v5)$SYMBOL,
x = 'log2FoldChange',
y = 'pvalue')
fourfiveplot

ggsave("outputs/fourvsfivevolcano.pdf", height = 16, width = 8)
fro mall of this we do see that HOx genes are not the most DEgenes. Instead we see the two DE genes that seem to be related to the trypsin? ctrl and prss1.
Many of the other top genes are interspersed through many other gene ontologies, including fatty acid metaboloism/transport, and location specific markers i.e. (cyp3a65 is expressed in the membrane of these structures: digestive system, eye, gill, heart and ovary.)
HOX genes only
Since this was my original question, let’s filter and generate a heatmap of just the HOX genes, and let’s see if we get some variability here.
library(pheatmap)
dds = readRDS("outputs/dds.rds")
ntd<-normTransform(dds)
select <- grep(rowData(ntd)$SYMBOL,pattern="hox")
df <- as.data.frame(colData(dds)[,"stageName"])
pheatmap(assay(ntd)[select,], cluster_rows=FALSE, show_rownames=TRUE,
cluster_cols=TRUE, annotation_col=df)
Warning in rev(brewer.pal(n = 7, name = "RdYlBu")) :
restarting interrupted promise evaluation
Warning in rev(brewer.pal(n = 7, name = "RdYlBu")) :
internal error -3 in R_decompress1
Error in rev(brewer.pal(n = 7, name = "RdYlBu")) :
lazy-load database '/Library/Frameworks/R.framework/Versions/4.1/Resources/library/RColorBrewer/R/RColorBrewer.rdb' is corrupt
LS0tCnRpdGxlOiAiREVTZXFBbmFseXNpcyIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKYGBge3Igc2V0dXAsIHdhcm5pbmc9RkFMU0UsIG1lc3NhZ2U9RkFMU0V9CmxpYnJhcnkoREVTZXEyKQpsaWJyYXJ5KG1hZ3JpdHRyKQpsaWJyYXJ5KEVuaGFuY2VkVm9sY2FubykKZGRzNHY1ID0gcmVhZFJEUygib3V0cHV0cy9kZHM0djUucmRzIikKZGRzNHZNID0gcmVhZFJEUygib3V0cHV0cy9kZHM0dk0ucmRzIikKZGRzNXZNID0gcmVhZFJEUygib3V0cHV0cy9kZHM1dk0ucmRzIikKYGBgCgojIEFuYWx5emluZyB0aGUgREVTZXEgb3V0cHV0CgpIZXJlIHdlIHJ1biBERVNlcTIgdG8gZ2V0IG91ciBERUdzIGZvciBvdXIgY29udHJhc3RzIG9mIGNob2ljZToKV2Ugd2lsbCBjb21wYXJlIHRoZSB0aHJlZSBkaWZmZXJlbnQgdGltZXBvaW50cyBhZ2FpbnN0IGVhY2ggb3RoZXIsIGdlbmVyYXRpbmcgYSB0b3RhbCBvZiAzIGNvbnRyYXN0cy4KMS4gcHJvdHJ1ZGluZyBtb3V0aCB2cyBkYXkgNAoyLiBkYXkgNCB2cyBkYXkgNQozLiBwcm90cnVkaW5nIG1vdXRoIHZzIGRheSA1CgpgYGB7ciBHZW5lcmF0aW5nIERFR3MgZm9yIGdyb3Vwc30KZGRzNHY1JHN0YWdlTmFtZSA8LSBkcm9wbGV2ZWxzKGRkczR2NSRzdGFnZU5hbWUpCmRkczR2TSRzdGFnZU5hbWUgPC0gZHJvcGxldmVscyhkZHM0dk0kc3RhZ2VOYW1lKQpkZHM1dk0kc3RhZ2VOYW1lIDwtIGRyb3BsZXZlbHMoZGRzNXZNJHN0YWdlTmFtZSkKZGRzNHY1ID0gREVTZXEoZGRzNHY1KQpkZHM0dk0gPSBERVNlcShkZHM0dk0pCmRkczV2TSA9IERFU2VxKGRkczV2TSkKcmVzNHY1IDwtIHJlc3VsdHMoZGRzNHY1LCB0ZXN0ID0gIldhbGQiKQpyZXM0dk0gPC0gcmVzdWx0cyhkZHM0dk0sIHRlc3QgPSAiV2FsZCIpCnJlczV2TSA8LSByZXN1bHRzKGRkczV2TSwgdGVzdCA9ICJXYWxkIikKYGBgCgpgYGB7ciBvdXRwdXRzfQpyZXM1dk0gPSBsZmNTaHJpbmsoZGRzPWRkczV2TSwgY29lZiA9ICJzdGFnZU5hbWVfRGF5LjVfdnNfUHJvdHJ1ZGluZy5tb3V0aCIscmVzID0gcmVzNXZNLCB0eXBlID0gImFzaHIiKQpyZXM0dk0gPSBsZmNTaHJpbmsoZGRzPWRkczR2TSwgY29lZiA9ICJzdGFnZU5hbWVfRGF5LjRfdnNfUHJvdHJ1ZGluZy5tb3V0aCIscmVzID0gcmVzNHZNLCB0eXBlID0gImFzaHIiKQpyZXM0djUgPSBsZmNTaHJpbmsoZGRzNHY1LCBjb250cmFzdCA9IGMoInN0YWdlTmFtZSIsICJEYXkuNCIsICJEYXkuNSIpLHJlcyA9IHJlczR2NSwgdHlwZT0iYXNociIpCmBgYApIZXJlIHdlIHVzIExGQ3NocmluayB2aWEgYXNociB0byBzaHJpbmsgb3VyIGxvZ2ZvbGQyIGNoYW5nZXMgZnJvbSB0aGUgREVTZXEgb3V0cHV0cyB3aXRoIHJlc3BlY3QgdG8gb3VyIGNvbnRyYXN0cy4gV2UgZG8gbm90IHVzZSBub3JtYWwgdHlwZSBhcyBhc2hyIGFuZCBhcGVnbG0gYm90aCBvdXRwZXJmb3JtIG5vcm1hbCBoZXJlLgoKCiMjIERpc3BlcnNpb24gRXN0aW1hdGVzCgpIZXJlIHdlIGdsYW5jZSBpbnRvIG91ciBkYXRhIHRvIHNlZSBpZiB0aGUgbW9kZWwgaXMgd2VsbCBmaXQgdG8gdGhlIGRhdGE6CmBgYHtyIGRpc3Blc3RpbWF0ZXMsIGZpZy5zaG93PSdob2xkJ30KcGxvdERpc3BFc3RzKGRkczR2NSkKcGxvdERpc3BFc3RzKGRkczR2TSkKcGxvdERpc3BFc3RzKGRkczV2TSkKYGBgCgpFdmVyeXRoaW5nIGxvb2tzIG1vc3RseSBva2F5IGhlcmU7IGl0IG1vc3RseSBmaXRzIHRoZSAibm9ybWFsIGxvb2siIGhlcmUuCgoKIyMgVG9wIEdlbmVzIGV4cHJlc3NlZCBpbiBEYXkgNSB2cyBNb3V0aCBQcm90cnVkaW5nCmBgYHtyIHRvcCBjb3VudHMgNXZNLCBmaWcuc2hvdz0naG9sZCcsIG91dC53aWR0aD0iNTAlIn0KKGZvciAoaSBpbiBvcmRlcihyZXM1dk0kcGFkaiwgZGVjcmVhc2luZyA9IEYpWzE6NV0pewogIHBsb3RDb3VudHMoZGRzNXZNLCBnZW5lPWksIGludGdyb3VwPSJzdGFnZU5hbWUiLCBtYWluID0gIiIpIAogIHRpdGxlKHJvd0RhdGEoZGRzNXZNKVtyb3duYW1lcyhyZXM1dk1baSxdKSxdJFNZTUJPTCkKfSkKYGBgCgojIyMgVm9sY2FubyBQbG90CgpgYGB7ciB2b2xjYW5vZml2ZXZNLCBmaWcuaGVpZ2h0PTE2LCBmaWcud2lkdGg9OH0KZml2ZU1wbG90ID0gRW5oYW5jZWRWb2xjYW5vKHJlczV2TSwKICBsYWIgPSByb3dEYXRhKGRkczV2TSkkU1lNQk9MLAogIHggPSAnbG9nMkZvbGRDaGFuZ2UnLAogIHkgPSAncHZhbHVlJykKCmZpdmVNcGxvdApnZ3NhdmUoIm91dHB1dHMvZml2ZXZzTXZvbGNhbm8ucGRmIiwgaGVpZ2h0ID0gMTYsIHdpZHRoID0gOCkKCmBgYAoKIyMgVG9wIEdlbmVzIGZvciBleHByZXNzZWQgRGF5NCB2cyBtb3V0aCBQcm90cnVkaW5nCgpgYGB7ciBkYXk0dk0sZmlnLnNob3c9J2hvbGQnLCBvdXQud2lkdGg9IjUwJSJ9Cihmb3IgKGkgaW4gb3JkZXIocmVzNHZNJHBhZGosIGRlY3JlYXNpbmcgPSBGKVsxOjVdKXsKICBwbG90Q291bnRzKGRkczR2TSwgZ2VuZT1pLCBpbnRncm91cD0ic3RhZ2VOYW1lIiwgbWFpbiA9ICIiKSAKICB0aXRsZShyb3dEYXRhKGRkczR2TSlbcm93bmFtZXMocmVzNHZNW2ksXSksXSRTWU1CT0wpCn0pCmBgYAoKIyMjIFZvbGNhbm8gUGxvdAoKYGBge3Igdm9sY2Fub2ZvdXJ2TSwgZmlnLmhlaWdodD0xNiwgZmlnLndpZHRoPTh9CmZvdXJNcGxvdCA9IEVuaGFuY2VkVm9sY2FubyhyZXM0dk0sCiAgbGFiID0gcm93RGF0YShkZHM0dk0pJFNZTUJPTCwKICB4ID0gJ2xvZzJGb2xkQ2hhbmdlJywKICB5ID0gJ3B2YWx1ZScpCgpmb3VyTXBsb3QKZ2dzYXZlKCJvdXRwdXRzL2ZvdXJ2c012b2xjYW5vLnBkZiIsIGhlaWdodCA9IDE2LCB3aWR0aCA9IDgpCmBgYAoKIyMgc2lnbmlmaWNhbnQgZ2VuZXMgNHY1CgpgYGB7ciBkYXk0djUsZmlnLnNob3c9J2hvbGQnLCBvdXQud2lkdGg9IjUwJSJ9Cihmb3IgKGkgaW4gb3JkZXIocmVzNHY1JHBhZGosIGRlY3JlYXNpbmcgPSBGKVsxOjVdKXsKICBwbG90Q291bnRzKGRkczR2NSwgZ2VuZT1pLCBpbnRncm91cD0ic3RhZ2VOYW1lIiwgbWFpbiA9ICIiKSAKICB0aXRsZShyb3dEYXRhKGRkczR2NSlbcm93bmFtZXMocmVzNHY1W2ksXSksXSRTWU1CT0wpCn0pCmBgYAoKIyMjIFZvbGNhbm8gcGxvdCA0djUKCmBgYHtyIHZvbGNhbm9mb3VydmZpdmUsIGZpZy5oZWlnaHQ9MTYsIGZpZy53aWR0aD04fQpmb3VyZml2ZXBsb3QgPSBFbmhhbmNlZFZvbGNhbm8ocmVzNHY1LAogIGxhYiA9IHJvd0RhdGEoZGRzNHY1KSRTWU1CT0wsCiAgeCA9ICdsb2cyRm9sZENoYW5nZScsCiAgeSA9ICdwdmFsdWUnKQoKZm91cmZpdmVwbG90Cmdnc2F2ZSgib3V0cHV0cy9mb3VydnNmaXZldm9sY2Fuby5wZGYiLCBoZWlnaHQgPSAxNiwgd2lkdGggPSA4KQpgYGAKZnJvIG1hbGwgb2YgdGhpcyB3ZSBkbyBzZWUgdGhhdCBIT3ggZ2VuZXMgYXJlIG5vdCB0aGUgbW9zdCBERWdlbmVzLiBJbnN0ZWFkIHdlIHNlZSB0aGUgdHdvIERFIGdlbmVzIHRoYXQgc2VlbSB0byBiZSByZWxhdGVkIHRvIHRoZSB0cnlwc2luPyBjdHJsIGFuZCBwcnNzMS4gCgpNYW55IG9mIHRoZSBvdGhlciB0b3AgZ2VuZXMgYXJlIGludGVyc3BlcnNlZCB0aHJvdWdoIG1hbnkgb3RoZXIgZ2VuZSBvbnRvbG9naWVzLCBpbmNsdWRpbmcgZmF0dHkgYWNpZCBtZXRhYm9sb2lzbS90cmFuc3BvcnQsIGFuZCBsb2NhdGlvbiBzcGVjaWZpYyBtYXJrZXJzIGkuZS4gKGN5cDNhNjUgaXMgZXhwcmVzc2VkIGluIHRoZSBtZW1icmFuZSBvZiB0aGVzZSBzdHJ1Y3R1cmVzOiBkaWdlc3RpdmUgc3lzdGVtLCBleWUsIGdpbGwsIGhlYXJ0IGFuZCBvdmFyeS4pCgojIyBIT1ggZ2VuZXMgb25seQoKU2luY2UgdGhpcyB3YXMgbXkgb3JpZ2luYWwgcXVlc3Rpb24sIGxldCdzIGZpbHRlciBhbmQgZ2VuZXJhdGUgYSBoZWF0bWFwIG9mIGp1c3QgdGhlIEhPWCBnZW5lcywgYW5kIGxldCdzIHNlZSBpZiB3ZSBnZXQgc29tZSB2YXJpYWJpbGl0eSBoZXJlLgoKYGBge3IgaGVhdG1hcEhPWCwgZmlnLmhlaWdodD0xMiwgZmlnLndpZHRoPTh9CmxpYnJhcnkocGhlYXRtYXApCmRkcyA9IHJlYWRSRFMoIm91dHB1dHMvZGRzLnJkcyIpCm50ZDwtbm9ybVRyYW5zZm9ybShkZHMpCnNlbGVjdCA8LSBncmVwKHJvd0RhdGEobnRkKSRTWU1CT0wscGF0dGVybj0iaG94IikKZGYgPC0gYXMuZGF0YS5mcmFtZShjb2xEYXRhKGRkcylbLCJzdGFnZU5hbWUiXSkKcGhlYXRtYXAoYXNzYXkobnRkKVtzZWxlY3QsXSwgY2x1c3Rlcl9yb3dzPUZBTFNFLCBzaG93X3Jvd25hbWVzPVRSVUUsCiAgICAgICAgIGNsdXN0ZXJfY29scz1UUlVFLCBhbm5vdGF0aW9uX2NvbD1kZikKCmBgYAoK